home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Doc / designeditors.int < prev    next >
Encoding:
Text File  |  2001-05-22  |  18.1 KB  |  490 lines
  1. { ********************************************************************** }
  2. {                                                                        }
  3. { Delphi and Kylix Cross-Platform Open Tools API                         }
  4. {                                                                        }
  5. { Copyright (C) 1995, 2001 Borland Software Corporation                  }
  6. {                                                                        }
  7. { All Rights Reserved.                                                   }
  8. {                                                                        }
  9. { ********************************************************************** }
  10.  
  11.  
  12. unit DesignEditors;
  13.  
  14. interface
  15.  
  16. uses
  17.   Types, SysUtils, Classes, TypInfo, Variants, DesignIntf, DesignMenus;
  18.  
  19. { Property Editors }
  20.  
  21. type
  22.   TInstProp = record
  23.     Instance: TPersistent;
  24.     PropInfo: PPropInfo;
  25.   end;
  26.  
  27.   PInstPropList = ^TInstPropList;
  28.   TInstPropList = array[0..1023] of TInstProp;
  29.  
  30.   TPropertyEditor = class(TBasePropertyEditor, IProperty)
  31.   protected
  32.     procedure SetPropEntry(Index: Integer; AInstance: TPersistent;
  33.       APropInfo: PPropInfo); override;
  34.   protected
  35.     function GetFloatValue: Extended;
  36.     function GetFloatValueAt(Index: Integer): Extended;
  37.     function GetInt64Value: Int64;
  38.     function GetInt64ValueAt(Index: Integer): Int64;
  39.     function GetMethodValue: TMethod;
  40.     function GetMethodValueAt(Index: Integer): TMethod;
  41.     function GetOrdValue: Longint;
  42.     function GetOrdValueAt(Index: Integer): Longint;
  43.     function GetStrValue: string;
  44.     function GetStrValueAt(Index: Integer): string;
  45.     function GetVarValue: Variant;
  46.     function GetVarValueAt(Index: Integer): Variant;
  47.     function GetIntfValue: IInterface;
  48.     function GetIntfValueAt(Index: Integer): IInterface;
  49.     procedure Modified;
  50.     procedure SetFloatValue(Value: Extended);
  51.     procedure SetMethodValue(const Value: TMethod);
  52.     procedure SetInt64Value(Value: Int64);
  53.     procedure SetOrdValue(Value: Longint);
  54.     procedure SetStrValue(const Value: string);
  55.     procedure SetVarValue(const Value: Variant);
  56.     procedure SetIntfValue(const Value: IInterface);
  57.   protected
  58.     { IProperty }
  59.     function GetEditValue(out Value: string): Boolean;
  60.     function HasInstance(Instance: TPersistent): Boolean;
  61.   public
  62.     constructor Create(const ADesigner: IDesigner; APropCount: Integer); override;
  63.     destructor Destroy; override;
  64.     procedure Activate; virtual;
  65.     function AllEqual: Boolean; virtual;
  66.     function AutoFill: Boolean; virtual;
  67.     procedure Edit; virtual;
  68.     function GetAttributes: TPropertyAttributes; virtual;
  69.     function GetComponent(Index: Integer): TPersistent;
  70.     function GetEditLimit: Integer; virtual;
  71.     function GetName: string; virtual;
  72.     procedure GetProperties(Proc: TGetPropProc); virtual;
  73.     function GetPropInfo: PPropInfo; virtual;
  74.     function GetPropType: PTypeInfo;
  75.     function GetValue: string; virtual;
  76.     function GetVisualValue: string;
  77.     procedure GetValues(Proc: TGetStrProc); virtual;
  78.     procedure Initialize; override;
  79.     procedure Revert;
  80.     procedure SetValue(const Value: string); virtual;
  81.     function ValueAvailable: Boolean;
  82.     property Designer: IDesigner;
  83.     property PrivateDirectory: string;
  84.     property PropCount: Integer;
  85.     property Value: string;
  86.   end;
  87.  
  88. { TOrdinalProperty
  89.   The base class of all ordinal property editors.  It established that ordinal
  90.   properties are all equal if the GetOrdValue all return the same value. }
  91.  
  92.   TOrdinalProperty = class(TPropertyEditor)
  93.     function AllEqual: Boolean; override;
  94.     function GetEditLimit: Integer; override;
  95.   end;
  96.  
  97. { TIntegerProperty
  98.   Default editor for all Longint properties and all subtypes of the Longint
  99.   type (i.e. Integer, Word, 1..10, etc.).  Restricts the value entered into
  100.   the property to the range of the sub-type. }
  101.  
  102.   TIntegerProperty = class(TOrdinalProperty)
  103.   public
  104.     function GetValue: string; override;
  105.     procedure SetValue(const Value: string); override;
  106.   end;
  107.  
  108. { TCharProperty
  109.   Default editor for all Char properties and sub-types of Char (i.e. Char,
  110.   'A'..'Z', etc.). }
  111.  
  112.   TCharProperty = class(TOrdinalProperty)
  113.   public
  114.     function GetValue: string; override;
  115.     procedure SetValue(const Value: string); override;
  116.   end;
  117.  
  118. { TEnumProperty
  119.   The default property editor for all enumerated properties (e.g. TShape =
  120.   (sCircle, sTriangle, sSquare), etc.). }
  121.  
  122.   TEnumProperty = class(TOrdinalProperty)
  123.   public
  124.     function GetAttributes: TPropertyAttributes; override;
  125.     function GetValue: string; override;
  126.     procedure GetValues(Proc: TGetStrProc); override;
  127.     procedure SetValue(const Value: string); override;
  128.   end;
  129.  
  130. { TBoolProperty is now obsolete.  TEnumProperty handles bool types. }
  131.  TBoolProperty = class(TEnumProperty)
  132.  end deprecated;
  133.  
  134. { TInt64Property
  135.   Default editor for all Int64 properties and all subtypes of Int64.  }
  136.  
  137.   TInt64Property = class(TPropertyEditor)
  138.   public
  139.     function AllEqual: Boolean; override;
  140.     function GetEditLimit: Integer; override;
  141.     function GetValue: string; override;
  142.     procedure SetValue(const Value: string); override;
  143.   end;
  144.  
  145. { TFloatProperty
  146.   The default property editor for all floating point types (e.g. Float,
  147.   Single, Double, etc.) }
  148.  
  149.   TFloatProperty = class(TPropertyEditor)
  150.   public
  151.     function AllEqual: Boolean; override;
  152.     function GetValue: string; override;
  153.     procedure SetValue(const Value: string); override;
  154.   end;
  155.  
  156. { TStringProperty
  157.   The default property editor for all strings and sub types (e.g. string,
  158.   string[20], etc.). }
  159.  
  160.   TStringProperty = class(TPropertyEditor)
  161.   public
  162.     function AllEqual: Boolean; override;
  163.     function GetEditLimit: Integer; override;
  164.     function GetValue: string; override;
  165.     procedure SetValue(const Value: string); override;
  166.   end;
  167.  
  168. { TNestedProperty
  169.   A property editor that uses the parent's Designer, PropList and PropCount.
  170.   The constructor and destructor do not call inherited, but all derived classes
  171.   should.  This is useful for properties like the TSetElementProperty. }
  172.  
  173.   TNestedProperty = class(TPropertyEditor)
  174.   public
  175.     constructor Create(Parent: TPropertyEditor); reintroduce;
  176.     destructor Destroy; override;
  177.   end;
  178.  
  179. { TSetElementProperty
  180.   A property editor that edits an individual set element.  GetName is
  181.   changed to display the set element name instead of the property name and
  182.   Get/SetValue is changed to reflect the individual element state.  This
  183.   editor is created by the TSetProperty editor. }
  184.  
  185.   TSetElementProperty = class(TNestedProperty)
  186.   protected
  187.     constructor Create(Parent: TPropertyEditor; AElement: Integer); reintroduce;
  188.     property Element: Integer;
  189.   public
  190.     function AllEqual: Boolean; override;
  191.     function GetAttributes: TPropertyAttributes; override;
  192.     function GetName: string; override;
  193.     function GetValue: string; override;
  194.     procedure GetValues(Proc: TGetStrProc); override;
  195.     procedure SetValue(const Value: string); override;
  196.    end;
  197.  
  198. { TSetProperty
  199.   Default property editor for all set properties. This editor does not edit
  200.   the set directly but will display sub-properties for each element of the
  201.   set. GetValue displays the value of the set in standard set syntax. }
  202.  
  203.   TSetProperty = class(TOrdinalProperty)
  204.   public
  205.     function GetAttributes: TPropertyAttributes; override;
  206.     procedure GetProperties(Proc: TGetPropProc); override;
  207.     function GetValue: string; override;
  208.   end;
  209.  
  210. { TClassProperty
  211.   Default property editor for all objects.  Does not allow modifying the
  212.   property but does display the class name of the object and will allow the
  213.   editing of the object's properties as sub-properties of the property. }
  214.  
  215.   TClassProperty = class(TPropertyEditor)
  216.   public
  217.     function GetAttributes: TPropertyAttributes; override;
  218.     procedure GetProperties(Proc: TGetPropProc); override;
  219.     function GetValue: string; override;
  220.   end;
  221.  
  222. { TMethodProperty
  223.   Property editor for all method properties. }
  224.  
  225.   TMethodProperty = class(TPropertyEditor, IMethodProperty)
  226.   public
  227.     function AllNamed: Boolean; virtual;
  228.     function AllEqual: Boolean; override;
  229.     procedure Edit; override;
  230.     function GetAttributes: TPropertyAttributes; override;
  231.     function GetEditLimit: Integer; override;
  232.     function GetValue: string; override;
  233.     procedure GetValues(Proc: TGetStrProc); override;
  234.     procedure SetValue(const AValue: string); override;
  235.     function GetFormMethodName: string; virtual;
  236.     function GetTrimmedEventName: string;
  237.   end;
  238.  
  239. { TComponentProperty
  240.   The default editor for TComponents.  It does not allow editing of the
  241.   properties of the component.  It allow the user to set the value of this
  242.   property to point to a component in the same form that is type compatible
  243.   with the property being edited (e.g. the ActiveControl property). }
  244.  
  245.   TComponentProperty = class(TPropertyEditor, IReferenceProperty)
  246.   protected
  247.     function FilterFunc(const ATestEditor: IProperty): Boolean;
  248.     function GetComponentReference: TComponent; virtual;
  249.     function GetSelections: IDesignerSelections; virtual;
  250.   public
  251.     function AllEqual: Boolean; override;
  252.     procedure Edit; override;
  253.     function GetAttributes: TPropertyAttributes; override;
  254.     procedure GetProperties(Proc: TGetPropProc); override;
  255.     function GetEditLimit: Integer; override;
  256.     function GetValue: string; override;
  257.     procedure GetValues(Proc: TGetStrProc); override;
  258.     procedure SetValue(const Value: string); override;
  259.   end;
  260.  
  261. { TInterfaceProperty
  262.   The default editor for interface references.  It allows the user to set
  263.   the value of this property to refer to an interface implemented by
  264.   a component on the form (or via form linking) that is type compatible
  265.   with the property being edited. }
  266.  
  267.   TInterfaceProperty = class(TComponentProperty)
  268.   protected
  269.     procedure ReceiveComponentNames(const S: string);
  270.     function GetComponent(const AInterface: IInterface): TComponent;
  271.     function GetComponentReference: TComponent; override;
  272.     function GetSelections: IDesignerSelections; override;
  273.   public
  274.     function AllEqual: Boolean; override;
  275.     procedure GetValues(Proc: TGetStrProc); override;
  276.     procedure SetValue(const Value: string); override;
  277.   end;
  278.  
  279. { TComponentNameProperty
  280.   Property editor for the Name property.  It restricts the name property
  281.   from being displayed when more than one component is selected. }
  282.  
  283.   TComponentNameProperty = class(TStringProperty)
  284.   public
  285.     function GetAttributes: TPropertyAttributes; override;
  286.     function GetEditLimit: Integer; override;
  287.   end;
  288.  
  289. { TDateProperty
  290.   Property editor for date portion of TDateTime type. }
  291.  
  292.   TDateProperty = class(TPropertyEditor)
  293.     function GetAttributes: TPropertyAttributes; override;
  294.     function GetValue: string; override;
  295.     procedure SetValue(const Value: string); override;
  296.   end;
  297.  
  298. { TTimeProperty
  299.   Property editor for time portion of TDateTime type. }
  300.  
  301.   TTimeProperty = class(TPropertyEditor)
  302.     function GetAttributes: TPropertyAttributes; override;
  303.     function GetValue: string; override;
  304.     procedure SetValue(const Value: string); override;
  305.   end;
  306.  
  307. { TDateTimeProperty
  308.   Edits both date and time data simultaneously  }
  309.  
  310.   TDateTimeProperty = class(TPropertyEditor)
  311.     function GetAttributes: TPropertyAttributes; override;
  312.     function GetValue: string; override;
  313.     procedure SetValue(const Value: string); override;
  314.   end;
  315.  
  316. { TVariantProperty }
  317.  
  318.   TVariantProperty = class(TPropertyEditor)
  319.     function GetAttributes: TPropertyAttributes; override;
  320.     function GetValue: string; override;
  321.     procedure SetValue(const Value: string); override;
  322.     procedure GetProperties(Proc: TGetPropProc); override;
  323.   end;
  324.  
  325. procedure GetComponentProperties(const Components: IDesignerSelections;
  326.   Filter: TTypeKinds; const Designer: IDesigner; Proc: TGetPropProc;
  327.   EditorFilterFunc: TPropertyEditorFilterFunc = nil);
  328.  
  329. { Component Editors }
  330.  
  331. type
  332. { TComponentEditor
  333.   This class provides a default implementation for the IComponentEditor
  334.   interface. There is no assumption by the designer that you use this class
  335.   only that your class derive from TBaseComponentEditor and implement
  336.   IComponentEditor. This class is provided to help you implement a class
  337.   that meets those requirements. }
  338.   TComponentEditor = class(TBaseComponentEditor, IComponentEditor)
  339.   public
  340.     constructor Create(AComponent: TComponent; ADesigner: IDesigner); override;
  341.     procedure Edit; virtual;
  342.     procedure ExecuteVerb(Index: Integer); virtual;
  343.     function GetComponent: TComponent;
  344.     function GetDesigner: IDesigner;
  345.     function GetVerb(Index: Integer): string; virtual;
  346.     function GetVerbCount: Integer; virtual;
  347.     function IsInInlined: Boolean;
  348.     procedure Copy; virtual;
  349.     procedure PrepareItem(Index: Integer; const AItem: IMenuItem); virtual;
  350.     property Component: TComponent;
  351.     property Designer: IDesigner;
  352.   end;
  353.  
  354. { TDefaultEditor
  355.   An editor that provides default behavior for the double-click that will
  356.   iterate through the properties looking the the most appropriate method
  357.   property to edit }
  358.   TDefaultEditor = class(TComponentEditor, IDefaultEditor)
  359.   protected
  360.     procedure EditProperty(const Prop: IProperty; var Continue: Boolean); virtual;
  361.   public
  362.     procedure Edit; override;
  363.   end;
  364.  
  365. function GetComponentEditor(Component: TComponent;
  366.   const Designer: IDesigner): IComponentEditor;
  367.  
  368. { Selection Editors }
  369.  
  370. type
  371.  
  372. { TSelectionEditor
  373.   This provides a default implementation of the ISelectionEditor interface.
  374.   There is no assumption by the designer that you use this class only that
  375.   you have a class derived from TBaseSelectionEditor and implements the
  376.   ISelectionEdtior interface. This class is provided to help you implement a
  377.   class the meets those requirements. This class is also the selection editor
  378.   that will be created if no other selection editor is registered for a class. }
  379.   TSelectionEditor = class(TBaseSelectionEditor, ISelectionEditor)
  380.   public
  381.     constructor Create(const ADesigner: IDesigner); override;
  382.     procedure ExecuteVerb(Index: Integer; const List: IDesignerSelections); virtual;
  383.     function GetVerb(Index: Integer): string; virtual;
  384.     function GetVerbCount: Integer; virtual;
  385.     procedure RequiresUnits(Proc: TGetStrProc); virtual;
  386.     procedure PrepareItem(Index: Integer; const AItem: IMenuItem); virtual;
  387.     property Designer: IDesigner;
  388.   end;
  389.  
  390. function GetSelectionEditors(const Designer: IDesigner): ISelectionEditorList; overload;
  391. function GetSelectionEditors(const Designer: IDesigner;
  392.   const Selections: IDesignerSelections): ISelectionEditorList; overload;
  393. function GetSelectionEditors(const Designer: IDesigner;
  394.   Component: TComponent): ISelectionEditorList; overload;
  395.  
  396. type
  397. { TEditActionSelectionEditor }
  398.  
  399.   TEditActionSelectionEditor = class(TSelectionEditor)
  400.   protected
  401.     function GetEditState: TEditState;
  402.     procedure EditAction(Action: TEditAction);
  403.  
  404.     procedure HandleCopy(Sender: TObject);
  405.     procedure HandleCut(Sender: TObject);
  406.     procedure HandleDelete(Sender: TObject);
  407.     procedure HandlePaste(Sender: TObject);
  408.     procedure HandleSelectAll(Sender: TObject);
  409.     procedure HandleUndo(Sender: TObject);
  410.   public
  411.     function GetVerb(Index: Integer): string; override;
  412.     function GetVerbCount: Integer; override;
  413.     procedure PrepareItem(Index: Integer; const AItem: IMenuItem); override;
  414.   end;
  415.  
  416. { Custom Modules }
  417.  
  418. type
  419. { TCustomModule
  420.   This class provides a default implementation of the ICustomModule interface.
  421.   There is no assumption by the designer that a custom module derives form
  422.   this class only that it derive from TBaseCustomModule and implement the
  423.   ICustomModule interface. This class is provided to help you implement a
  424.   class that meets those requirements. }
  425.   TCustomModule = class(TBaseCustomModule, ICustomModule)
  426.   public
  427.     constructor Create(ARoot: TComponent; const ADesigner: IDesigner); override;
  428.     destructor Destroy; override;
  429.     procedure ExecuteVerb(Index: Integer); virtual;
  430.     function GetAttributes: TCustomModuleAttributes; virtual;
  431.     function GetVerb(Index: Integer): string; virtual;
  432.     function GetVerbCount: Integer; virtual;
  433.     procedure Saving; virtual;
  434.     procedure PrepareItem(Index: Integer; const AItem: IMenuItem); virtual;
  435.     procedure ValidateComponent(Component: TComponent); virtual;
  436.     function ValidateComponentClass(ComponentClass: TComponentClass): Boolean; virtual;
  437.     function Nestable: Boolean; virtual;
  438.     property Root: TComponent;
  439.     property Designer: IDesigner;
  440.   end;
  441.  
  442. { ClassInheritsFrom
  443.   Returns true if ClassType, or one of its ancestors, name matches
  444.   ClassName. This allows checking ancestor by name instead of by class
  445.   reference. }
  446.  
  447. function ClassInheritsFrom(ClassType: TClass; const ClassName: string): Boolean;
  448.  
  449. { AncestorNameMatches
  450.   Returns true if either ClassType descends from AncestorClass or doesn't
  451.   contain an ancestor class by the same name as AncestorClass. This ensures that
  452.   if ClassType has an ancestor by the same name it is AncestorClass. }
  453.  
  454. function AncestorNameMatches(ClassType: TClass; AncestorClass: TClass): Boolean;
  455.  
  456. { Find the top level component (form, module, etc) }
  457.  
  458. type
  459.   TGetTopLevelComponentFunc = function(Ignoring: TComponent = nil): TComponent;
  460.  
  461. var
  462.   GetTopLevelComponentFunc: TGetTopLevelComponentFunc;
  463.  
  464. resourcestring
  465.   sClassNotApplicable = 'Class %s is not applicable to this module';
  466.   sNotAvailable = '(Not available)';
  467.  
  468. function PossibleStream(const S: string): Boolean;
  469.  
  470. { Routines used by the form designer for package management }
  471.  
  472. type
  473.   TGroupChangeProc = procedure(AGroup: Integer);
  474.  
  475.   IDesignGroupChange = interface
  476.     ['{8B5614E7-A726-4622-B2A7-F79340B1B78E}']
  477.     procedure FreeEditorGroup(Group: Integer);
  478.   end;
  479.  
  480. function NewEditorGroup: Integer;
  481. procedure FreeEditorGroup(Group: Integer);
  482. procedure NotifyGroupChange(AProc: TGroupChangeProc);
  483. procedure UnnotifyGroupChange(AProc: TGroupChangeProc);
  484.  
  485. var
  486.   GReferenceExpandable: Boolean = True;
  487.   GShowReadOnlyProps: Boolean = True;
  488.  
  489. implementation
  490.